home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / paslib.arc / COMLIB.INC < prev    next >
Text File  |  1986-11-16  |  5KB  |  193 lines
  1.  
  2. {$U+}
  3.  
  4.   var
  5.     Port,Baud,StopBits,DataBits,Par: Integer;
  6.  
  7.  
  8. { A set of routines to enable COM1 and COM2 to be accessed from Turbo Pascal.
  9.   Included in Convair W/ permission. Taken and Derived from Turbo Tutor
  10.   by Borland.
  11.  
  12.   AssignAux(PortNumber in [1,2]) assigns Aux to COM1 or COM2
  13.   AssignUsr(PortNumber in [1,2]) assigns Usr to COM1 or COM2
  14.   SetSerial(PortNumber in [1,2],
  15.             BaudRate in [110,150,300,600,1200,2400,4800,9600],
  16.             StopBits in [1,2],
  17.             DataBits in [7,8],
  18.             Parity in [None,Even,Odd]) sets the baud rate, stop bits, data
  19.                                bits, and parity of one of the serial ports.
  20.  
  21.   The arrays InError and OutError may be examined to detect errors.  The bits
  22.   are as follows:
  23.      Bit 7 (128)        Time out (no device connected)
  24.      Bit 3 (8)          Framing error
  25.      Bit 2 (4)          Parity error
  26.      Bit 1 (2)          Overrun error
  27.  
  28.   Function SerialStatus(PortNumber in [1,2]) returns a more complete status:
  29.      Bit 15 (negative)  Time out (no device connected)
  30.      Bit 14 (16384)     Transmission shift register empty
  31.      Bit 13 (8192)      Transmission holding register empty
  32.      Bit 12 (4096)      Break detect
  33.      Bit 11 (2048)      Framing error
  34.      Bit 10 (1024)      Parity error
  35.      Bit 9  (512)       Overrun error
  36.      Bit 8  (256)       Data ready
  37.      Bit 7  (128)       Received line signal detect
  38.      Bit 6  (64)        Ring indicator
  39.      Bit 5  (32)        Data set ready
  40.      Bit 4  (16)        Clear to send
  41.      Bit 3  (8)         Delta receive line signal detect
  42.      Bit 2  (4)         Trailing edge ring detector
  43.      Bit 1  (2)         Delta data set ready
  44.      Bit 0  (1)         Delta clear to send
  45.  
  46.   Identifiers starting with "__" are not meant to be used by the user program.
  47. }
  48.  
  49.   Type
  50.     __RegisterSet=Record case Integer of
  51.                   1: (AX,BX,CX,DX,BP,DI,SE,DS,ES,Flags: Integer);
  52.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  53.                 end;
  54.     __ParityType=(None,Even,Odd);
  55.  
  56.   var
  57.     __Regs: __RegisterSet;
  58.     InError,OutError: Array [1..2] of Byte;
  59.  
  60.   procedure __Int14(PortNumber,Command,Parameter: Integer);
  61.   { do a BIOS COM driver interrupt }
  62.  
  63.     begin
  64.       with __Regs do
  65.        begin
  66.         DX:=PortNumber-1;
  67.         AH:=Command;
  68.         AL:=Parameter;
  69.         Flags:=0;
  70.         Intr($14,__Regs);
  71.        end;
  72.     end;
  73.  
  74.  
  75.   procedure SetSerial(PortNumber,BaudRate,StopBits,DataBits: Integer;
  76.                       Parity: __ParityType);
  77.   { Set serial parameters on a COM port }
  78.  
  79.     var
  80.       Parameter: Integer;
  81.  
  82.     begin
  83.       case BaudRate of
  84.         110: BaudRate:=0;
  85.         150: BaudRate:=1;
  86.         300: BaudRate:=2;
  87.         600: BaudRate:=3;
  88.         1200: BaudRate:=4;
  89.         2400: BaudRate:=5;
  90.         4800: BaudRate:=6;
  91.         9600: BAUDRATE:=7;
  92.         else BaudRate:=4; { Default to 1200 baud }
  93.        end;
  94.       if StopBits=2 then StopBits:=1
  95.       else StopBits:=0; { Default to 1 stop bit }
  96.       if DataBits=7 then DataBits:=2
  97.       else DataBits:=3; { Default to 8 data bits }
  98.       Parameter:=(BaudRate Shl 5)+(StopBits Shl 2)+DataBits;
  99.       case Parity of
  100.         Odd: Parameter:=Parameter+8;
  101.         Even: Parameter:=Parameter+24;
  102.         else; { Default to no parity }
  103.        end;
  104.       __Int14(PortNumber,0,Parameter);
  105.     end;
  106.  
  107.  
  108.   Function SerialStatus(PortNumber: Integer): Integer;
  109.   { Return the status of a COM port }
  110.  
  111.     begin
  112.       __Int14(PortNumber,3,0);
  113.       SerialStatus:=__Regs.AX;
  114.     end;
  115.  
  116.  
  117.   procedure __OutPort1(C: Byte);
  118.   { Called by Write to Aux or Usr when assigned to COM1 }
  119.  
  120.     begin
  121.       while (SerialStatus(1) and $30)=0 do ;
  122.       __Int14(1,1,C);
  123.       OutError[1]:=OutError[1] Or (__Regs.AH and $8E);
  124.     end;
  125.  
  126.  
  127.   procedure __OutPort2(C: Byte);
  128.   { Called by Write to Aux or Usr when assigned to COM2 }
  129.  
  130.     begin
  131.       while (SerialStatuS(2) and $30)=0 do ;
  132.       __Int14(2,1,C);
  133.       OutError[2]:=OutError[2] Or (__Regs.AH and $8E);
  134.     end;
  135.  
  136.  
  137.   Function __InPort1: Char;
  138.   { Called by Read from Aux or Usr when assigned to COM1 }
  139.  
  140.     begin
  141.       __Int14(1,2,0);
  142.       __InPort1:=Chr(__Regs.AL);
  143.       InError[1]:=InError[1] Or (__Regs.AH and $8E);
  144.     end;
  145.  
  146.  
  147.   Function __InPort2: Char;
  148.   { Called by Read from Aux or Usr when assigned to COM2 }
  149.  
  150.     begin
  151.       __Int14(2,2,0);
  152.       __InPort2:=Chr(__Regs.AL);
  153.       InError[2]:=InError[2] Or (__Regs.AH and $8E);
  154.     end;
  155.  
  156.  
  157.   procedure __AssignPort(PortNumber: Integer; var InPtr,OutPtr: Integer);
  158.   { Assign either Aux or Usr to either COM1 or COM2 }
  159.  
  160.     begin
  161.       if PortNumber=2 then
  162.        begin
  163.         OutPtr:=Ofs(__OutPort2);
  164.         InPtr:=Ofs(__InPort2);
  165.        end
  166.       else { Default to port 1 }
  167.        begin
  168.         OutPtr:=Ofs(__OutPort1);
  169.         InPtr:=Ofs(__InPort1);
  170.        end;
  171.       InError[PortNumber]:=0;
  172.       OutError[PortNumber]:=0;
  173.     end;
  174.  
  175.  
  176.   procedure AssignAux(PortNumber: Integer);
  177.   { Assign Aux to either COM1 or COM2 }
  178.  
  179.     begin
  180.       __AssignPort(PortNumber,AuxInPtr,AuxOutPtr);
  181.     end;
  182.  
  183.  
  184.   procedure AssignUsr(PortNumber: Integer);
  185.   { Assign Usr to either COM1 or COM2 }
  186.  
  187.  
  188.     begin
  189.       __AssignPort(PortNumber,UsrInPtr,UsrOutPtr);
  190.     end;
  191.  
  192.  
  193.